home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1993…ch: Other People's Memory / ADC Developer CD (1993-03) (''Other People's Memory'')_iso / Dev.CD Mar 93.iso / Development Platforms / LISP Related / LISP Goodies / ift-icon-dialog-item.lisp < prev    next >
Encoding:
Text File  |  1992-09-02  |  2.4 KB  |  65 lines  |  [TEXT/CCL2]
  1. ;;; Extension to IFT for icon-dialog-items
  2. ;;; Daniel LaLiberte (liberte@ncsa.uiuc.edu) July 1992
  3.  
  4. ;;; I use oodles-of-utils to set up the resource file where the icon resides.
  5.  
  6. ;;; Problem: make sure you are using a valid icon resource ID or you 
  7. ;;; may crash MCL or worse.
  8.  
  9. (in-package :interface-tools)
  10.  
  11. (require 'icon-dialog-item)
  12.  
  13. ;; Fixes to icon-dialog-item.lisp
  14. (defmethod ccl::view-default-size ((view ccl:icon-dialog-item))
  15.   #@(32 32))
  16.  
  17. (defmethod ccl::set-view-size :before ((view ccl:icon-dialog-item) h &optional v)
  18.   (declare (ignore h v))
  19.   (invalidate-view view))
  20.  
  21.  
  22. ;;;; Extensions to IFT for icon-dialog-item ;;;;;
  23.  
  24. (add-editable-dialog-item (make-instance 'ccl:icon-dialog-item
  25.                                          :icon ccl:*note-icon*))
  26. ;; (remove-editable-dialog-item 'ccl:icon-dialog-item)
  27. ;; (remove-editable-dialog-item 'ccl:array-dialog-item)
  28.  
  29.  
  30. (defmethod add-editor-items :after ((icon-item ccl:icon-dialog-item) editor)
  31.   (let* ((position *editor-items-start-pos*)
  32.          (size #@(116 16))
  33.          (delta (make-point 0 (+ (point-v size) 5))))
  34.     (add-subviews 
  35.      editor
  36.      (make-dialog-item 'check-box-dialog-item
  37.                          position size "Color Icon"
  38.                          #'(lambda (item)
  39.                              (setf (ccl::color-p icon-item)
  40.                                    (check-box-checked-p item))
  41.                              (invalidate-view icon-item t)
  42.                              )
  43.                          :check-box-checked-p (ccl::color-p icon-item))
  44.      (make-dialog-item 'button-dialog-item
  45.                        (setq position (add-points position delta))
  46.                        size "Set icon #"
  47.                        #'(lambda (item)
  48.                              (declare (ignore item))
  49.                              (setf (ccl::icon icon-item)
  50.                                    (read-from-string
  51.                                     (get-string-from-user
  52.                                      "Please enter a new icon number for the icon."
  53.                                      :initial-string
  54.                                      (format nil "~s" (ccl::icon icon-item)))))
  55.                              (invalidate-view icon-item t)
  56.                              ))
  57.      )))
  58.  
  59.  
  60. (defmethod object-source-code ((item ccl:icon-dialog-item))
  61.   (nconc (call-next-method)
  62.          `(:color-p ,(ccl::color-p item))
  63.          `(:icon ,(ccl::icon item))
  64.          ))
  65.